perm filename TRFAI.FAI[MSS,LCS] blob sn#264026 filedate 1977-02-14 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002		TITLE TRFAI
C00011 ENDMK
C⊗;
	TITLE TRFAI
	INTERNAL LOOKX,LOOK,LOOKF
	ENTRY CODEN,RLOOP
	ENTRY SLRV,IFIX,FLOAT,EXCH
	EXTERNAL AMOD,PX,Q
	INTERNAL PUTEXT,EXTOUT,GETEXT,EXTIN,FINEXT

; WRITES AND READS DUMP MODE FILES WITH ANY EXTENSION.
	CH←12
	CH2←11
	BLKS←←=1

DEFINE ERROR (MSG)
<	JSA 16,.ERROR
	JUMP [ASCIZ/MSG/
]
>

REGS:	BLOCK 20
;CALL PUTEXT(<FILE>,<EXT>)

PUTEXT:	0	;USES EXTOUT,FINEXT, CH2
	MOVE 0,@0(16)
	MOVEM 0,FILNAM
	MOVE 0,@1(16)
	MOVEM 0,EXTNAM
	JSA 16,INTFIL
	SETZM DIR+2
	SETZM DIR+3
	ENTER CH2,DIR
	ERROR <ENTER FAILED>
	JRA 16,2(16)
DIR:	BLOCK 4

;CALL EXTOUT(<ARRAY>,<NO. OF WORDS>)

EXTOUT:	0
	HRRZ 0,0(16)
	SUBI 0,1
	MOVEM 0,COM
	MOVN 0,@1(16)
	HRLM 0,COM
	OUTPUT CH2,COM
	STATZ CH2,740000
	ERROR <WRITE ERROR>
	JRA 16,2(16)


INTFIL:	0	;INITS DSK 
	MOVEI REGS
	BLT REGS+3
	INIT CH2,17
	SIXBIT/DSK/
	0
	ERROR <CAN'T INIT DSK!>
INTF8:	MOVE 0,FILNAM#
	MOVEM 0,FN#
	MOVE 1,[POINT 7,FN]
INTF7:	MOVE 2,[POINT 6,DIR]
	SETZM DIR
	MOVEI 3,5
INTF5:	ILDB 0,1
	CAIN 0," "
	JRST INTF6
	SUBI 0,40
	IDPB 0,2
	SOJG 3,INTF5
INTF6:	HRLZI REGS
	BLT 3
	MOVE 0,EXTNAM#
	MOVEM 0,EX#
	MOVE 1,[POINT 7,EX]
	MOVE 2,[POINT 6,DIR+1]
	SETZM DIR+1
	MOVEI 3,5
EXTF1:	ILDB 0,1
	CAIN 0," "
	JRST EXTF2
	SUBI 0,40
	IDPB 0,2
	SOJG 3,EXTF1
EXTF2:	HRLZI REGS
	BLT 3
	JRA 16,0(16)


COM:	OCT 0,0
COM1:	0
BLKNUM:	0

;CALL FINEXT
FINEXT:	0
	CLOSE CH2,0
	STATZ CH2,740000
	ERROR <ERROR AFTER CLOSE>
	RELEASE CH2,0
	JRA 16,0(16)

;CALL GETEXT(<FILE>,<EXT>)

GETEXT:	0
	MOVE 0,@0(16)
	MOVEM 0,FILNAM
	MOVE 0,@1(16)
	MOVEM 0,EXTNAM
	JSA 16,INTFIZ
	SETZM DIR+3
	SETZM DIR+2
	LOOKUP CH,DIR
	ERROR <LOOKUP FAILED>
	JRA 16,2(16)


INTFIZ:	0	;INITS DSK FOR INPUT
	MOVEI REGS
	BLT REGS+3
	INIT CH,17
	SIXBIT/DSK/
	0
	ERROR <CAN'T INIT DSK!>
	JRST INTF8


;CALL FASTI2(<ARRAY>,<NO. WORDS>)

EXTIN:	0
	HRRZ 0,0(16)
	SUBI 0,1
	MOVEM 0,COM
	MOVN 0,@1(16)
	HRLM 0,COM
	INPUT CH,COM
	STATZ CH,740000
	0
	JRA 16,2(16)
           
DEFINE ERROR (MSG)
<	JSA 16,.ERROR
	JUMP [ASCIZ/MSG/
]
>

.ERROR:	0
	OUTSTR [ASCIZ/?
/]				;MAKE SURE HE CAN SEE HIS ERROR
	OUTSTR @(16)		;OUTPUT ERROR MESSAGE
	CALLI 1,12		;LET USER CONTI2UE
	JRA 16,1(16)

	CH←13


;LOOK(<FILE>) FOR NO EXT., LOOKD() FOR .DAT, LOOKF() FOR .DMD
LOOKF:	0
	MOVSI 0,'DMD'
	JRST LOOK1
LOOKX:	0
	MOVE	0,@1(16)
	MOVEM 	0,FILNAM
	JSA 16, INTFIQ
	MOVE 0,DIR
	JRST LOOK1
LOOK:	0
	MOVEI	0,0
LOOK1:	MOVEM	0,DIR+1
	MOVE	0,@(16)
	MOVEM 	0,FILNAM
	JSA 16, INTFIQ
	SETZM	DIR+2
	SETZM	DIR+3
	LOOKUP	CH,DIR
	TDZA	0,0
	MOVNI	0,1
	JRA 16,1(16)

INTFIQ:	0	;INITS DSK FOR INPUT
	MOVEI REGS
	BLT REGS+3
	INIT CH,17
	SIXBIT/DSK/
	0
	HALT .-3
;	ERROR <CAN'T INIT DSK!>

INTF4:	MOVE 0,FILNAM#
	MOVEM 0,FN#
	MOVE 1,[POINT 7,FN]
INTF3:	MOVE 2,[POINT 6,DIR]
	SETZM DIR
	MOVEI 3,5
INTF1:	ILDB 0,1
	CAIN 0," "
	JRST INTF2
	SUBI 0,40
	IDPB 0,2
	SOJG 3,INTF1
INTF2:	HRLZI REGS
	BLT 3
	JRA 16,0(16)

RLOOP:	0		;CALL RLOOP(A,B,K)
	HRLI 1,@1(16)	;DIMENSION A(1),B(1)  --  SOURCE
	HRRI 1,@(16)	;DO 1 J=1,K     -- DESTINATION
	MOVE 2,(16)    ;1	A(J)=B(J)  -- WORD COUNT
	ADD  2,@2(16)  ;LOC OF ARRAY A + WDCNT.
	BLT  1,-1(2)
	JRA 16,3(16)

IFIX:	0
	KIFIX 0,@(16)
	JRA 16,1(16)
FLOAT:	0
	FLTR 0,@(16)
	JRA 16,1(16)

EXCH:	0
	MOVE @(16)
	EXCH @1(16)
	MOVEM @(16)
	JRA 16,2(16)

SLRV:	0		; CALL SLRV(KK,C)
	MOVE 1,@(16)	; KK
	MOVE 2,@1(16)	; C
	FADRM 2,Q+3(1)	; WORKS WITH Q ARRAY ONLY******
	FADRM 2,Q+4(1)	; FOR Q(KK+4) AND (KK+5)
	MOVNS Q+6(1)	; Q(KK+7)
	JRA 16,2(16)

CODEN:	0		;FUNCTION CODEN(K,N,R,M)
	MOVE 1,@1(16)	;PNTR TO K ARRAY
	SOJ 1,
	ADD 1,(16)	;ADD LOC OF K ARRAY
	MOVE 1,(1)	;GET PNTR TO R ARRAY
	MOVEM 1,@3(16)	;SEND IT BACK IN M
	ADD  1,2(16)	;ADD LOC OF R ARRAY
	MOVE (1)	;R(M+1)  (CODE NUM OF ITEM)
	JRA 16,4(16)
	
	END